home *** CD-ROM | disk | FTP | other *** search
/ Creative Computers / Creative Computers CD-ROM, Volume 1 (Legendary Design Technologies, Inc.)(1994).iso / shareware / intuition / reqtools_2.1e / glue / m2amiga / m2amiga_glue.lha / ReqTFileReq.mod < prev    next >
Text File  |  1992-08-17  |  3KB  |  96 lines
  1. (*---------------------------------------------------------------------------
  2.   :Program.    ReqTFileReq.mod
  3.   :Contents.   Simple Benutzung des ReqTools Filerequesters
  4.   :Author.     Frank Lömker
  5.   :Copyright.  Public Domain
  6.   :Language.   Modula-2
  7.   :Translator. M2Amiga V4.0d
  8.   :Support.    Basiert zu großen Teilen auf ARPFileReq von Bernd Preußing
  9.   :Imports.    ReqTools 2.0m [kai]
  10.   :History.    V1.0, [Frank Lömker] 24-Feb-92
  11.   :History.    V1.1, [Frank Lömker] 03-Jul-92 Requester nicht freigegeben
  12.   :History.    V1.2, [Frank Lömker] 10-Aug-92 Save-Mode, Patternrückgabe,
  13.   :History.                                   LockWindow
  14.   :Bugs.       keine bekannt
  15. ---------------------------------------------------------------------------*)
  16. IMPLEMENTATION MODULE ReqTFileReq;
  17.  
  18. (*$ LargeVars:=FALSE StackParms:=FALSE RangeChk:=FALSE OverflowChk:=FALSE
  19.     ReturnChk:=FALSE StackChk:=FALSE EntryClear:=FALSE *)
  20.  
  21. FROM UtilityD IMPORT tagEnd;
  22. FROM SYSTEM   IMPORT ADR,ADDRESS,TAG,LONGSET;
  23. FROM String   IMPORT Copy, LastPos, Length, Concat;
  24. IMPORT rt:ReqTools;
  25.  
  26. TYPE str110=ARRAY [0..110] OF CHAR;
  27.      str110Ptr=POINTER TO str110;
  28.  
  29. VAR filereq:rt.FileRequesterPtr;
  30.     tagbuf:ARRAY [0..5] OF LONGINT;
  31.     File, Dir: str110;
  32.  
  33. PROCEDURE GetPath(VAR f,d:ARRAY OF CHAR);
  34. VAR pos,i:INTEGER;
  35. BEGIN
  36.   Copy(d,f);
  37.   pos:=LastPos(f,1000,'/');
  38.   IF pos<0 THEN
  39.     pos:=LastPos(f,1000,':');
  40.   END;
  41.   IF pos>=0 THEN
  42.     IF d[pos]=':' THEN d[pos+1]:=0C ELSE d[pos]:=0C END;
  43.     INC(pos);
  44.     FOR i:=pos TO Length(f) DO
  45.       f[i-pos]:=f[i]
  46.     END;
  47.     f[i]:=0C;
  48.   ELSE
  49.     d[0]:=0C
  50.   END;
  51. END GetPath;
  52.  
  53. PROCEDURE FileReq (VAR FName:ARRAY OF CHAR; Window:ADDRESS; Title:ARRAY OF CHAR;
  54.                    x,y:INTEGER;VAR pattern:ARRAY OF CHAR;save:BOOLEAN):BOOLEAN;
  55. VAR ok,pat:BOOLEAN;
  56. BEGIN
  57.   ok:=FALSE; pat:=FALSE;
  58.   filereq := rt.AllocRequestA (rt.TypeFileReq, NIL);
  59.   IF filereq # NIL THEN
  60.     Copy (File,FName);
  61.     GetPath (File,Dir);
  62.     IF Length (pattern)>0 THEN
  63.       pat:=TRUE;
  64.       rt.ChangeReqAttrA (filereq,TAG(tagbuf,rt.fiDir,ADR(Dir),
  65.                                         rt.fiMatchPat,ADR(pattern),tagEnd));
  66.       filereq^.flags:=filereq^.flags+LONGSET{rt.fReqPatGad,rt.fReqNoBuffer};
  67.     ELSE
  68.       rt.ChangeReqAttrA (filereq,TAG(tagbuf,rt.fiDir,ADR(Dir),tagEnd));
  69.       INCL (filereq^.flags,rt.fReqNoBuffer);
  70.     END;
  71.     IF save THEN INCL (filereq^.flags,rt.fReqSave); END;
  72.     IF x>=0 THEN filereq^.leftOffset:=x; END;
  73.     IF y>=0 THEN filereq^.topOffset:=y; END;
  74.     IF (x>=0) OR (y>=0) THEN filereq^.reqPos:=rt.ReqPosTopLeftScr; END;
  75.     IF rt.FileRequest (filereq, ADR(File),ADR(Title),
  76.                 TAG(tagbuf,rt.Window,Window,rt.LockWindowTag,TRUE,tagEnd)) THEN
  77.       Dir:=str110Ptr(filereq^.dir)^;
  78.       IF (Length(Dir)>0) AND (Dir[Length(Dir)-1]#':') THEN
  79.         Concat(Dir,'/');
  80.       END;
  81.       Concat(Dir,File);
  82.       Copy(FName,Dir);
  83.       IF pat THEN
  84.         Copy (pattern,str110Ptr(filereq^.matchPat)^);
  85.       END;
  86.       ok:=TRUE;
  87.     END;
  88.     rt.FreeRequest (filereq);
  89.   END;
  90.   RETURN ok;
  91. END FileReq;
  92.  
  93. BEGIN
  94.   NoPat:="";
  95. END ReqTFileReq.mod
  96.